home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXHINTS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  15.6 KB  |  530 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit RxHints;
  12.  
  13. {$I RX.INC}
  14.  
  15. interface
  16.  
  17. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Messages,
  18.   Graphics, Classes, Controls, Forms, Dialogs;
  19.  
  20. type
  21.   THintStyle = (hsRectangle, hsRoundRect, hsEllipse);
  22.   THintPos = (hpTopRight, hpTopLeft, hpBottomRight, hpBottomLeft);
  23.   THintShadowSize = 0..15;
  24.  
  25.   TRxHintWindow = class(THintWindow)
  26.   private
  27.     FSrcImage: TBitmap;
  28.     FImage: TBitmap;
  29.     FPos: THintPos;
  30.     FRect: TRect;
  31.     FTextRect: TRect;
  32.     FTileSize: TPoint;
  33.     FRoundFactor: Integer;
  34.     procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  35. {$IFDEF RX_D3}
  36.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  37. {$ENDIF}
  38.     function CreateRegion(Shade: Boolean): HRgn;
  39.     procedure FillRegion(Rgn: HRgn; Shade: Boolean);
  40.   protected
  41.     procedure CreateParams(var Params: TCreateParams); override;
  42.     procedure Paint; override;
  43.   public
  44.     constructor Create(AOwner: TComponent); override;
  45.     destructor Destroy; override;
  46.     procedure ActivateHint(Rect: TRect; const AHint: string); override;
  47. {$IFDEF RX_D3}
  48.     procedure ActivateHintData(Rect: TRect; const AHint: string;
  49.       AData: Pointer); override;
  50. {$ENDIF}
  51.     function CalcHintRect(MaxWidth: Integer; const AHint: string;
  52.       AData: Pointer): TRect; {$IFDEF RX_D3} override; {$ENDIF}
  53.   end;
  54.  
  55. procedure SetHintStyle(Style: THintStyle; ShadowSize: THintShadowSize;
  56.   Tail: Boolean; Alignment: TAlignment);
  57. procedure SetStandardHints;
  58. procedure RegisterHintWindow(AClass: THintWindowClass);
  59. function GetHintControl: TControl;
  60.  
  61. implementation
  62.  
  63. uses SysUtils, VclUtils, AppUtils, MaxMin;
  64.  
  65. const
  66.   HintStyle: THintStyle = hsRectangle;
  67.   HintShadowSize: THintShadowSize = 0;
  68.   HintTail: Boolean = False;
  69.   HintAlignment: TAlignment = taLeftJustify;
  70.  
  71. { Utility routines }
  72.  
  73. procedure RegisterHintWindow(AClass: THintWindowClass);
  74. begin
  75.   HintWindowClass := AClass;
  76.   with Application do
  77.     if ShowHint then begin
  78.       ShowHint := False;
  79.       ShowHint := True;
  80.     end;
  81. end;
  82.  
  83. procedure SetStandardHints;
  84. begin
  85.   RegisterHintWindow(THintWindow);
  86. end;
  87.  
  88. procedure SetHintStyle(Style: THintStyle; ShadowSize: THintShadowSize;
  89.   Tail: Boolean; Alignment: TAlignment);
  90. begin
  91.   HintStyle := Style;
  92.   HintShadowSize := ShadowSize;
  93.   HintTail := Tail;
  94.   HintAlignment := Alignment;
  95.   RegisterHintWindow(TRxHintWindow);
  96. end;
  97.  
  98. function GetHintControl: TControl;
  99. var
  100.   CursorPos: TPoint;
  101. begin
  102.   GetCursorPos(CursorPos);
  103.   Result := FindDragTarget(CursorPos, True);
  104.   while (Result <> nil) and not Result.ShowHint do
  105.     Result := Result.Parent;
  106.   if (Result <> nil) and (csDesigning in Result.ComponentState) then
  107.     Result := nil;
  108. end;
  109.  
  110. procedure StandardHintFont(AFont: TFont);
  111. {$IFDEF WIN32}
  112. var
  113.   NonClientMetrics: TNonClientMetrics;
  114. {$ENDIF}
  115. begin
  116. {$IFDEF WIN32}
  117.   NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  118.   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  119.     AFont.Handle := CreateFontIndirect(NonClientMetrics.lfStatusFont)
  120.   else begin
  121.     AFont.Name := 'MS Sans Serif';
  122.     AFont.Size := 8;
  123.   end;
  124.   AFont.Color := clInfoText;
  125. {$ELSE}
  126.   AFont.Name := 'MS Sans Serif';
  127.   AFont.Size := 8;
  128.   AFont.Color := clWindowText;
  129. {$ENDIF}
  130. end;
  131.  
  132. {$IFDEF WIN32}
  133. {$IFNDEF RX_D3}
  134. function GetCursorHeightMargin: Integer;
  135. { Return number of scanlines between the scanline containing cursor hotspot
  136.   and the last scanline included in the cursor mask. }
  137. var
  138.   IconInfo: TIconInfo;
  139.   BitmapInfoSize: Integer;
  140.   BitmapBitsSize: Integer;
  141.   Bitmap: PBitmapInfoHeader;
  142.   Bits: Pointer;
  143.   BytesPerScanline, ImageSize: Integer;
  144.  
  145.     function FindScanline(Source: Pointer; MaxLen: Cardinal;
  146.       Value: Cardinal): Cardinal; assembler;
  147.     asm
  148.             PUSH    ECX
  149.             MOV     ECX,EDX
  150.             MOV     EDX,EDI
  151.             MOV     EDI,EAX
  152.             POP     EAX
  153.             REPE    SCASB
  154.             MOV     EAX,ECX
  155.             MOV     EDI,EDX
  156.     end;
  157.  
  158. begin
  159.   { Default value is entire icon height }
  160.   Result := GetSystemMetrics(SM_CYCURSOR);
  161.   if GetIconInfo(GetCursor, IconInfo) then
  162.   try
  163.     GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize);
  164.     Bitmap := AllocMem(BitmapInfoSize + BitmapBitsSize);
  165.     try
  166.       Bits := Pointer(Longint(Bitmap) + BitmapInfoSize);
  167.       if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and
  168.         (Bitmap^.biBitCount = 1) then
  169.       begin
  170.         { Point Bits to the end of this bottom-up bitmap }
  171.         with Bitmap^ do
  172.         begin
  173.           BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8;
  174.           ImageSize := biWidth * BytesPerScanline;
  175.           Bits := Pointer(Integer(Bits) + BitmapBitsSize - ImageSize);
  176.           { Use the width to determine the height since another mask bitmap
  177.             may immediately follow }
  178.           Result := FindScanline(Bits, ImageSize, $FF);
  179.           { In case the and mask is blank, look for an empty scanline in the
  180.             xor mask. }
  181.           if (Result = 0) and (biHeight >= 2 * biWidth) then
  182.             Result := FindScanline(Pointer(Integer(Bits) - ImageSize),
  183.               ImageSize, $00);
  184.           Result := Result div BytesPerScanline;
  185.         end;
  186.         Dec(Result, IconInfo.yHotSpot);
  187.       end;
  188.     finally
  189.       FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize);
  190.     end;
  191.   finally
  192.     if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
  193.     if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
  194.   end;
  195. end;
  196. {$ENDIF}
  197. {$ENDIF}
  198.  
  199. { TRxHintWindow }
  200.  
  201. constructor TRxHintWindow.Create(AOwner: TComponent);
  202. begin
  203.   inherited Create(AOwner);
  204.   StandardHintFont(Canvas.Font);
  205.   FImage := TBitmap.Create;
  206.   FSrcImage := TBitmap.Create;
  207. end;
  208.  
  209. destructor TRxHintWindow.Destroy;
  210. begin
  211.   FSrcImage.Free;
  212.   FImage.Free;
  213.   inherited Destroy;
  214. end;
  215.  
  216. procedure TRxHintWindow.CreateParams(var Params: TCreateParams);
  217. begin
  218.   inherited CreateParams(Params);
  219.   Params.Style := Params.Style and not WS_BORDER;
  220. end;
  221.  
  222. {$IFDEF RX_D3}
  223. procedure TRxHintWindow.WMNCPaint(var Message: TMessage);
  224. begin
  225. end;
  226. {$ENDIF}
  227.  
  228. procedure TRxHintWindow.WMEraseBkgnd(var Message: TMessage);
  229. begin
  230.   Message.Result := 1;
  231. end;
  232.  
  233. function TRxHintWindow.CreateRegion(Shade: Boolean): HRgn;
  234. var
  235.   R: TRect;
  236.   W, TileOffs: Integer;
  237.   Tail, Dest: HRgn;
  238.   P: TPoint;
  239.  
  240.   function CreatePolyRgn(const Points: array of TPoint): HRgn;
  241.   type
  242.     PPoints = ^TPoints;
  243.     TPoints = array[0..0] of TPoint;
  244.   begin
  245.     Result := CreatePolygonRgn(PPoints(@Points)^, High(Points) + 1, WINDING);
  246.   end;
  247.  
  248. begin
  249.   R := FRect;
  250.   Result := 0;
  251.   if Shade then OffsetRect(R, HintShadowSize, HintShadowSize);
  252.   case HintStyle of
  253.     hsRoundRect: Result := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom,
  254.       FRoundFactor, FRoundFactor);
  255.     hsEllipse: Result := CreateEllipticRgnIndirect(R);
  256.     hsRectangle: Result := CreateRectRgnIndirect(R);
  257.   end;
  258.   if HintTail then begin
  259.     R := FTextRect;
  260.     GetCursorPos(P);
  261.     TileOffs := 0;
  262.     if FPos in [hpTopLeft, hpBottomLeft] then TileOffs := Width;
  263.     if Shade then begin
  264.       OffsetRect(R, HintShadowSize, HintShadowSize);
  265.       Inc(TileOffs, HintShadowSize);
  266.     end;
  267.     W := Min(Max(8, Min(WidthOf(R), HeightOf(R)) div 4), WidthOf(R) div 2);
  268.     case FPos of
  269.       hpTopRight:
  270.         Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
  271.           Point(R.Left + W div 4, R.Bottom), Point(R.Left + 2 * W, R.Bottom)]);
  272.       hpTopLeft:
  273.         Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
  274.           Point(R.Right - W div 4, R.Bottom), Point(R.Right - 2 * W, R.Bottom)]);
  275.       hpBottomRight:
  276.         Tail := CreatePolyRgn([Point(TileOffs, 0),
  277.           Point(R.Left + W div 4, R.Top), Point(R.Left + 2 * W, R.Top)]);
  278.       else {hpBottomLeft}
  279.         Tail := CreatePolyRgn([Point(TileOffs, 0),
  280.           Point(R.Right - W div 4, R.Top), Point(R.Right - 2 * W, R.Top)]);
  281.     end;
  282.     try
  283.       Dest := Result;
  284.       Result := CreateRectRgnIndirect(R);
  285.       try
  286.         CombineRgn(Result, Dest, Tail, RGN_OR);
  287.       finally
  288.         if Dest <> 0 then DeleteObject(Dest);
  289.       end;
  290.     finally
  291.       DeleteObject(Tail);
  292.     end;
  293.   end;
  294. end;
  295.  
  296. procedure TRxHintWindow.FillRegion(Rgn: HRgn; Shade: Boolean);
  297. begin
  298.   if Shade then begin
  299.     FImage.Canvas.Brush.Bitmap :=
  300. {$IFDEF RX_D4}
  301.       AllocPatternBitmap(clBtnFace, clWindowText);
  302. {$ELSE}
  303.       CreateTwoColorsBrushPattern(clBtnFace, clWindowText);
  304. {$ENDIF}
  305.     FImage.Canvas.Pen.Style := psClear;
  306.   end
  307.   else begin
  308.     FImage.Canvas.Pen.Style := psSolid;
  309.     FImage.Canvas.Brush.Color := Color;
  310.   end;
  311.   try
  312.     PaintRgn(FImage.Canvas.Handle, Rgn);
  313.     if not Shade then begin
  314.       FImage.Canvas.Brush.Color := Font.Color;
  315. {$IFDEF WIN32}
  316.       if (HintStyle = hsRectangle) and not HintTail then begin
  317.         DrawEdge(FImage.Canvas.Handle, FRect, BDR_RAISEDOUTER, BF_RECT);
  318.       end
  319.       else
  320. {$ENDIF}
  321.         FrameRgn(FImage.Canvas.Handle, Rgn, FImage.Canvas.Brush.Handle, 1, 1);
  322.     end;
  323.   finally
  324.     if Shade then begin
  325. {$IFDEF RX_D4}
  326.       FImage.Canvas.Brush.Bitmap := nil;
  327. {$ELSE}
  328.       FImage.Canvas.Brush.Bitmap.Free;
  329. {$ENDIF}
  330.       FImage.Canvas.Pen.Style := psSolid;
  331.     end;
  332.     FImage.Canvas.Brush.Color := Color;
  333.   end;
  334. end;
  335.  
  336. procedure TRxHintWindow.Paint;
  337. var
  338.   R: TRect;
  339.   FShadeRgn, FRgn: HRgn;
  340.  
  341.   procedure PaintText(R: TRect);
  342.   const
  343.     Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  344. {$IFNDEF WIN32}
  345.   var
  346.     ACaption: array[0..255] of Char;
  347. {$ENDIF}
  348.   begin
  349. {$IFDEF WIN32}
  350.     DrawText(FImage.Canvas.Handle, PChar(Caption),
  351. {$ELSE}
  352.     DrawText(FImage.Canvas.Handle, StrPCopy(ACaption, Caption),
  353. {$ENDIF}
  354.       -1, R, DT_NOPREFIX or DT_WORDBREAK or Flag[HintAlignment]
  355.       {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  356.   end;
  357.  
  358. begin
  359.   R := ClientRect;
  360.   FImage.Handle := CreateCompatibleBitmap(Canvas.Handle,
  361.     WidthOf(ClientRect), HeightOf(ClientRect));
  362.   FImage.Canvas.Font := Self.Canvas.Font;
  363.   if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
  364.     FImage.Canvas.Draw(0, 0, FSrcImage);
  365.   FRgn := CreateRegion(False);
  366.   FShadeRgn := CreateRegion(True);
  367.   try
  368.     FillRegion(FShadeRgn, True);
  369.     FillRegion(FRgn, False);
  370.   finally
  371.     DeleteObject(FShadeRgn);
  372.     DeleteObject(FRgn);
  373.   end;
  374.   R := FTextRect;
  375.   if HintAlignment = taLeftJustify then Inc(R.Left, 2);
  376.   PaintText(R);
  377.   Canvas.Draw(0, 0, FImage);
  378. end;
  379.  
  380. procedure TRxHintWindow.ActivateHint(Rect: TRect; const AHint: string);
  381. var
  382.   R: TRect;
  383.   ScreenDC: HDC;
  384.   P: TPoint;
  385. begin
  386.   Caption := AHint;
  387.   GetCursorPos(P);
  388.   FPos := hpBottomRight;
  389.   R := CalcHintRect(Screen.Width, AHint, nil);
  390. {$IFDEF RX_D3}
  391.   OffsetRect(R, Rect.Left - R.Left, Rect.Top - R.Top);
  392. {$ELSE}
  393.  {$IFDEF WIN32}
  394.   OffsetRect(R, P.X, P.Y + GetCursorHeightMargin);
  395.  {$ELSE}
  396.   OffsetRect(R, P.X, Rect.Top - R.Top);
  397.  {$ENDIF WIN32}
  398. {$ENDIF}
  399.   Rect := R;
  400.   BoundsRect := Rect;
  401.  
  402.   if HintTail then begin
  403.     Rect.Top := P.Y - Height - 3;
  404.     if Rect.Top < 0 then Rect.Top := BoundsRect.Top
  405.     else Rect.Bottom := Rect.Top + HeightOf(BoundsRect);
  406.  
  407.     Rect.Left := P.X + 1;
  408.     if Rect.Left < 0 then Rect.Left := BoundsRect.Left
  409.     else Rect.Right := Rect.Left + WidthOf(BoundsRect);
  410.   end;
  411.  
  412.   if Rect.Top + Height > Screen.Height then begin
  413.     Rect.Top := Screen.Height - Height;
  414.     if Rect.Top <= P.Y then Rect.Top := P.Y - Height - 3;
  415.   end;
  416.   if Rect.Left + Width > Screen.Width then begin
  417.     Rect.Left := Screen.Width - Width;
  418.     if Rect.Left <= P.X then Rect.Left := P.X - Width -3;
  419.   end;
  420.   if Rect.Left < 0 then begin
  421.     Rect.Left := 0;
  422.     if Rect.Left + Width >= P.X then Rect.Left := P.X - Width - 1;
  423.   end;
  424.   if Rect.Top < 0 then begin
  425.     Rect.Top := 0;
  426.     if Rect.Top + Height >= P.Y then Rect.Top := P.Y - Height - 1;
  427.   end;
  428.  
  429.   if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
  430.   begin
  431.     FPos := hpBottomRight;
  432.     if (Rect.Top + Height < P.Y) then FPos := hpTopRight;
  433.     if (Rect.Left + Width < P.X) then begin
  434.       if FPos = hpBottomRight then FPos := hpBottomLeft
  435.       else FPos := hpTopLeft;
  436.     end;
  437.     if HintTail then begin
  438.       if (FPos in [hpBottomRight, hpBottomLeft]) then begin
  439.         OffsetRect(FRect, 0, FTileSize.Y);
  440.         OffsetRect(FTextRect, 0, FTileSize.Y);
  441.       end;
  442.       if (FPos in [hpBottomRight, hpTopRight]) then begin
  443.         OffsetRect(FRect, FTileSize.X, 0);
  444.         OffsetRect(FTextRect, FTileSize.X, 0);
  445.       end;
  446.     end;
  447.     if HandleAllocated then begin
  448.       SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_HIDEWINDOW or
  449.         SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOMOVE);
  450.       if Screen.ActiveForm <> nil then UpdateWindow(Screen.ActiveForm.Handle);
  451.     end;
  452.     ScreenDC := GetDC(0);
  453.     try
  454.       with FSrcImage do begin
  455.         Width := WidthOf(BoundsRect);
  456.         Height := HeightOf(BoundsRect);
  457.         BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Rect.Left,
  458.           Rect.Top, SRCCOPY);
  459.       end;
  460.     finally
  461.       ReleaseDC(0, ScreenDC);
  462.     end;
  463.   end;
  464.   SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, 0,
  465.     0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
  466. end;
  467.  
  468. function TRxHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  469.   AData: Pointer): TRect;
  470. const
  471.   Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  472. var
  473.   A: Integer;
  474.   X, Y, Factor: Double;
  475. {$IFNDEF WIN32}
  476.   ACaption: array[0..255] of Char;
  477. {$ENDIF}
  478. begin
  479.   Result := Rect(0, 0, MaxWidth, 0);
  480.   DrawText(Canvas.Handle,
  481. {$IFDEF WIN32}
  482.     PChar(AHint),
  483. {$ELSE}
  484.     StrPCopy(ACaption, AHint),
  485. {$ENDIF}
  486.     -1, Result, DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or Flag[HintAlignment]
  487.     {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  488.   Inc(Result.Right, 8);
  489.   Inc(Result.Bottom, 4);
  490.   FRect := Result;
  491.   FTextRect := Result;
  492.   InflateRect(FTextRect, -1, -1);
  493.   case HintAlignment of
  494.     taCenter: OffsetRect(FTextRect, -1, 0);
  495.     taRightJustify: OffsetRect(FTextRect, -4, 0);
  496.   end;
  497.   FRoundFactor := Max(6, Min(WidthOf(Result), HeightOf(Result)) div 4);
  498.   if HintStyle = hsRoundRect then
  499.     InflateRect(FRect, FRoundFactor div 4, FRoundFactor div 4)
  500.   else if HintStyle = hsEllipse then begin
  501.     X := WidthOf(FRect) / 2;
  502.     Y := HeightOf(FRect) / 2;
  503.     if (X <> 0) and (Y <> 0) then begin
  504.       Factor := Round(Y / 3);
  505.       A := Round(Sqrt((Sqr(X) * Sqr(Y + Factor)) / (Sqr(Y + Factor) - Sqr(Y))));
  506.       InflateRect(FRect, A - Round(X), Round(Factor));
  507.     end;
  508.   end;
  509.   Result := FRect;
  510.   OffsetRect(FRect, -Result.Left, -Result.Top);
  511.   OffsetRect(FTextRect, -Result.Left, -Result.Top);
  512.   Inc(Result.Right, HintShadowSize);
  513.   Inc(Result.Bottom, HintShadowSize);
  514.   if HintTail then begin
  515.     FTileSize.Y := Max(14, Min(WidthOf(FTextRect), HeightOf(FTextRect)) div 2);
  516.     FTileSize.X := FTileSize.Y - 8;
  517.     Inc(Result.Right, FTileSize.X);
  518.     Inc(Result.Bottom, FTileSize.Y);
  519.   end;
  520. end;
  521.  
  522. {$IFDEF RX_D3}
  523. procedure TRxHintWindow.ActivateHintData(Rect: TRect; const AHint: string;
  524.   AData: Pointer);
  525. begin
  526.   ActivateHint(Rect, AHint);
  527. end;
  528. {$ENDIF}
  529.  
  530. end.